'---- Programa Sam1ImageConv1b.amos baseado em Msx1ImageConv1c - rgb - cluster
'---- iniciado em 22oct00

Dim RFROMAT(16),GFROMAT(16),BFROMAT(16)
Dim REALPAL(16),GRPLTLV(16),CELCNT(16)
DIM OPALETR(16),OPALETG(16),OPALETB(16)
DIM NPALETR(16),NPALETG(16),NPALETB(16)
dim XPNT(8,8)

START:
SCREEN 0,0,0: COLOR 0,7 :CLS
 PRINT:PRINT" SamCoupe mode1 (8x8) image converter (bmp 16c - 8/4bit) - 0111261752"
 PRINT:PRINT" Drag a file icon here over this dos-console window and press enter"
 PRINT:PRINT" This converter will generate a binary msx1 screen and a 8bit bmp file"
 PRINT" with the same name from its source":PRINT: PRINT" ";
INPUT F1$
 ON ERROR GOTO START
F1T=LEN(F1$):F3$=LEFT$(F1$,F1T-4)+".BM8"
 OPEN F1$ FOR RANDOM AS #1 LEN=1:F1B$="A":FIELD #1,1 AS FB1$
 OPEN F3$ FOR RANDOM AS #3 LEN=1:F3B$="A":FIELD #3,1 AS FB3$

'---- cabecalho do formato bmp-8bit
DTABMP8HD:
  DATA 66,77,124,192,0,0,0,0,0,0,122,0,0,0,40,0
  DATA 0,0,0,1,0,0,192,0,0,0,1,0,8,0,0,0
  DATA 0,0,0,0,0,0,16,10,0,0,16,10,0,0,17,0
  DATA 0,0,17,0,0,0
  data 0,0,0,0,0,0,0,0,34,204,34,0,34,136,34,0
  data 238,34,34,0,238,102,68,0,34,34,170,0,238,204,68,0
  data 34,34,238,0,102,102,238,0,136,204,204,0,34,204,204,0
  data 34,136,34,0,170,68,204,0,170,170,170,0,238,238,238,0
  data 255,255,255,0
RESTORE DTABMP8HD
  FOR I=1 TO 122:READ GRD:SEEK #3,I:LSET FB3$=CHR$(GRD):PUT #3:NEXT I
GET #1,19:XSIZ0=ASC(FB1$):GET #1,20:XSIZ1=ASC(FB1$)
 XMAX=XSIZ0+(XSIZ1*256):XMAXO=INT(XMAX/8):XMAXOO=XMAXO*8:XSM0=(XMAXOO AND 255)
 SEEK #3,19:LSET FB3$=CHR$(XSM0):PUT #3:SEEK #3,20:LSET FB3$=CHR$(XSIZ1):PUT #3
GET #1,23:YSIZ0=ASC(FB1$):GET #1,24:YSIZ1=ASC(FB1$)
 YMAX=YSIZ0+(YSIZ1*256):YMAXO=INT(YMAX/8):YMAXOO=YMAXO*8:YSM0=(YMAXOO AND 255)
 SEEK #3,23:LSET FB3$=CHR$(YSM0):PUT #3:SEEK #3,24:LSET FB3$=CHR$(YSIZ1):PUT #3

'---- bmp source format
   YMPOS= 28+1:GET #1, YMPOS:BITDEPTH=ASC(FB1$)
   YMPOS= 11+1:GET #1, YMPOS:IMSTART=(ASC(FB1$))*256
   YMPOS= 10+1:GET #1, YMPOS:IMSTART=IMSTART+ASC(FB1$)
    PALSZ=INT((IMSTART-54)/4)
ORDEREDPALETTE:
  IF PALSZ>16 THEN PALSZ=16
FOR I=0 TO PALSZ-1: YMPOS= 54+1+(I*4)
    GET #1, YMPOS+1: J=INT(ASC(FB1$)/32):GRKY=J MOD 2
      OPALETG(I)=J:J2=INT((J*255)/7)
      SEEK #3,YMPOS+1:LSET FB3$=CHR$(J2):PUT #3
    GET #1, YMPOS  : J=(INT(ASC(FB1$)/64)*2)+GRKY
      OPALETR(I)=J:J2=INT((J*255)/7)
      SEEK #3,YMPOS  :LSET FB3$=CHR$(J2):PUT #3
    GET #1, YMPOS+2: J=(INT(ASC(FB1$)/64)*2)+GRKY
      OPALETB(I)=J:J2=INT((J*255)/7)
      SEEK #3,YMPOS+2:LSET FB3$=CHR$(J2):PUT #3
 NEXT I

FOR I=PALSZ-1 TO 15
    OPALETR(I)=OPALETR(PALSZ-1):OPALETG(I)=OPALETG(PALSZ-1)
    OPALETB(I)=OPALETB(PALSZ-1)
 NEXT I
FOR I=0 TO 15
    NPALETR(I)=((OPALETR(I))*255)/7:NPALETG(I)=((OPALETG(I))*255)/7
    NPALETB(I)=((OPALETB(I))*255)/7
    GRPLTLV(I)=(NPALETG(I)*59)+(NPALETR(I)*30)+(NPALETB(I)*11)
 NEXT I

'----transfer palette converting for msx2 limits / define palette grayscale 
FOR Y=0 TO 15
  GPAL=OPALETG(Y):BPAL=OPALETB(Y):RPAL=OPALETR(Y)
  GRPLTLV(Y)=((((BPAL*11)+(RPAL*30)+(GPAL*59))*255)/700)
  RFROMAT(Y)=(RPAL*255)/7:GFROMAT(Y)=(GPAL*255)/7:BFROMAT(Y)=(BPAL*255)/7
NEXT Y

'----correcao da paleta 
FOR I=0 TO 15:REALPAL(I)=I:NEXT I
FOR J=0 TO 15:FOR I=0 TO 14
  IF GRPLTLV(I)>GRPLTLV(I+1) THEN
    SWAP GRPLTLV(I),GRPLTLV(I+1)
    SWAP RFROMAT(I),RFROMAT(I+1):SWAP GFROMAT(I),GFROMAT(I+1)
    SWAP BFROMAT(I),BFROMAT(I+1):SWAP REALPAL(I),REALPAL(I+1)
  END IF 
NEXT I:NEXT J

'----main loop 
FOR Y1=0 TO YMAXO-1
     LOCATE 24,2:PRINT USING"###%";(Y1*100)/YMAXO;
  FOR X1=0 TO XMAXO-1

'----atribute reading and mounting
       FOR I=0 TO 15:CELCNT(I)=0:NEXT I
    FOR Y2=0 TO 7
      FOR X2=0 TO 7
          Y=(Y1*8)+Y2 
          XP=(X1*8)+X2: IY=(YMAX-1)-Y 
        XH=INT(XP/2)
          IF BITDEPTH=8 THEN
            YMPOS= IMSTART+1+XP+(IY*XMAX): GET #1, YMPOS
            XPNT(X2,Y2)=(ASC(FB1$)) MOD 16
           END IF
          IF BITDEPTH=4 THEN
            YMPOS= IMSTART+1+XH+(IY*(INT(XMAX/2))): GET #1, YMPOS
            U1=ASC(FB1$): U2=X2 MOD 2
              IF U2=0 THEN
                U3=240 : U4=16
              END IF
              IF U2=1 THEN
               U3=15:U4=1
              END IF
            XPNT(X2,Y2)= INT((U1 AND U3)/U4)
          END IF
            U=XPNT(X2,Y2)   
        CELCNT(U)=CELCNT(U)+1000+(RND(99))
      NEXT X2
    NEXT Y2

        IKATTR=0 : PAATTR=0:IKCNT=0 : PACNT=0
      FOR I=0 TO 15
	IF IKCNT<CELCNT(I) THEN
          IKCNT=CELCNT(I):IKATTR=I
        END IF 
      NEXT I

        CELCNT(IKATTR)=0
      FOR I=0 TO 15
	IF PACNT<CELCNT(I) THEN
          PACNT=CELCNT(I):PAATTR=I
        END IF 
      NEXT I

        IF IKATTR<PAATTR THEN SWAP IKATTR,PAATTR
      LUMD=(GRPLTLV(IKATTR)+GRPLTLV(PAATTR))/2

        IKO=INT(IKATTR/8):PAO=INT(PAATTR/8)
      IF IKO<>PAO THEN
           DIPTT=9999:IKOK=(IKO*8)
         FOR I=0+IKOK TO 7+IKOK
             DISR=ABS(NPALETR(I)-NPALETR(PAATTR))
             DISG=ABS(NPALETG(I)-NPALETG(PAATTR))
             DISB=ABS(NPALETB(I)-NPALETB(PAATTR))
	     DIST=SQR((DISR^2)+(DISG^2)+(DISB^2))
               IF DIST<DIPTT AND I<>PAATTRS THEN
                 DIPTT=DIST
                 PAATTRN=I
               END IF
	 NEXT I
           PAATTR=PAATTRN
      END IF

'---- reading original 16 colour image as grayscale for screen 2 
        PKVAR=0
    FOR Y2=0 TO 7
      FOR X2=0 TO 7
        Y=Y2+(Y1*8)
        X=X2+(X1*8):IY=(YMAXOO-1)-Y
            U=XPNT(X2,Y2): IK=PAATTR
	  IF GRPLTLV(U)>LUMD THEN
            IK=IKATTR
          END IF 
            SEEK #3,123+(IY*XMAXOO)+X:LSET FB3$=CHR$(IK):PUT #3
      NEXT X2
    NEXT Y2
  NEXT X1
NEXT Y1

   CLOSE #1:CLOSE #3
GOTO START
